TITL DAI FIRMWARE 0E92D-0EA3F V1.0 Rev.1 ORG :E92D * * * ************************* * LENGTH OF BLOCK IN BC * ************************* * * Part of Run 'CLEAR' (D214). * MPT45 CALL :DE1A Calc. length of block MOV B,H ) MOV C,L ) Length in BC RET * ********************** * EVALUATE A COMPARE * ********************** * * Decodes flags and opcode to a truthtable. * Following a XFCOMP or a XICOMP by a jump to * E933 leaves FF (true) or 00 (false) in A as * result. * * Entry: E: Opcode. * F: Flags. * Exit: BCDEF preserved, HL corrupted. * A: Truth value. * ROREL PUSH PSW Save flags MOV A,E ) ANI :0F ) Calc offset ADD A ) ADD A ) LXI H,:E943 Base addr CALL :DE30 Add offset to base POP PSW Restore flags MVI A,:FF Init truth value PCHL Goto routine * ROGEQ RP FF if MACC >= M JMP :E958 (S=0) * ROGT JM :E958 FF if MACC > M NOP (S=0 and Z=0) * RONEQ RNZ FF if MACC <> M JMP :E958 (Z=0) * ROLEQ RZ FF if MACC <= M NOP (S=1 or Z=1) NOP NOP * ROLT RM FF if MACC < M JMP :E958 (S=1) * ROEQ RZ FF if MACC = M REM (Z=1) * RFALSE CMA 00 if condition false RET * **************************** * RUN A VARIABLE REFERENCE * **************************** * * Produces a pointer to the value of a variable. * The variable may be simple or subscripted and * of any type. If subscripted, subscripts are * evaluated and checked for range. * * Entry: BC: Points to encoded variable. * D: 0 if MACC free. * Exit: BC updated, DE preserved, F corrupted. * HL: Points to variable storage. * A: Type of variable from symbol table. * RARRN PUSH D XRA A Array name only * RVREN MVI D,:00 JMP :D73D Run varptr * DATA :FF DATA :FF * ************************************* * RUN VARPTR (ARRAY WITH ARGUMENTS) * ************************************* * * Runs a varptr with A=FF, D=0. * * Exit: BC updated, DE preserved, MACC corrupted. * HL: Varptr. * A: T/L byte. * RVAR PUSH D MVI A,:FF Set mask for arrays (not REM name only) JMP :E95C Run varptr * DATA :FF DATA :FF * ************************** * RUN A VARIABLE POINTER * ************************** * * RVARE: Entry for arrays. * RVR05: 'Normal' entry. * * Entry: BC: Points to var.reference in program. * A: Mask. * D: 0 if MACC free. * Exit: HL: Varptr (for strings: stringpntr). * A: T/L of symtab. * BC updated, DE preserved. * RVARE MVI A,:FF Not array name only RVR05 PUSH PSW PUSH D LDAX B ) INX B ) ANI :3F ) Get offset in symtab MOV D,A ) in DE LDAX B ) INX B ) MOV E,A ) LHLD :02A1 Get start symtab DAD D HL pnts to actual addr REM in symtab POP D POP PSW Restore mask ANA M And with T/L byte ANI :40 Bit 6 only MOV A,M INX H RZ Abort if simple variable or REM array name only REM * Compute actual position in array: REM DCR D INR D Check D=0: MACC free CNZ :C018 Save MACC on stack if not PUSH D PUSH PSW MOV E,M ) Get pntr from symtab INX H ) in DE MOV D,M ) INX H MOV A,D ) Check if undimensioned ORA E ) ERRUA MVI A,:0F Then run error JZ :D9F5 'UNDEFINED ARRAY' PUSH D LXI H,:0000 Init index XTHL Pntr to array in HL LDAX B Get nr of subscripts INX B MOV D,A in D CMP M Comp. with nr of dimensions INX H JNZ :DA29 Run 'SUBSCRIPT ERROR' if REM not identical RVR10 CALL :E74F Get variable type in A RVR15 CMP M JC :E9B1 If value in A is offset JZ :E9B1 MVI A,:05 If subscript <0 or >FF: JMP :D9F5 Run 'SUBSCRIPT ERROR' REM * Calc reference to Nth array element * via (a1*(d2+1)+a2*(d3+1)+..+aN). aN * is argument, dN is dimension: REM RVR20 XTHL Restore HL=00 CALL :DE30 Add offset to index DCR D decr nr of arguments XTHL INX H JZ :E9C5 If no more subscipts MOV A,M Next dimension INR A XTHL CALL :DE8F Multiply index by it XTHL JMP :E9A2 Process next subscript * RVR30 XCHG POP H Get index to array from REM symtab POP PSW Get type byte PUSH PSW ANI :30 Bits 5,6 only CPI :20 DAD H Add offset to element JZ :E9D2 DAD H RVR40 DAD D Abs addr of element in HL REM (STR: pntr to string) POP PSW POP D CNZ :C01B Evt retrieve MACC from stack RET * **************************** * EVALUATE A FUNCTION CALL * **************************** * * Finds address of function routine in * indirection table (#E9F0) and performs the * function routine. * * Entry: BC: Points to function label (#20) * in program line. * Exit: MACC: Numeric result. * BC updated, AFDEHL corrupted. * RFUN INX B Pnts past label LDAX B Get function code INX B MOV L,A Code in HL MVI H,:00 LXI D,:E9F0 Get startaddr. table DAD H Code *2 DAD D Add offset to startaddr MOV E,M lobyte addr in E INX H MOV A,M hibyte addr in A ORI :80 Set msb = 1 MOV D,A hibyte in D CMP M Was it already E...? PUSH D Addr function on stack CZ :E808 Then evaluate 1st num REM expr, result in MACC RET Go to function routine * ****************************** * FUNCTION INDIRECTION TABLE * ****************************** * * Startaddress table is E9F0. The function code * is given between brackets. * If the msb of the address is set, the first * argument is a numeric one. * * In the textbuffer, the Basic fuctions are * indicated by 20 xx, (xx is function code). * FUNIT DBL :EA50 (00) ABS DBL :EA53 (01) ALOG DBL :6ACB (02) ASC DBL :6AD2 (03) CHR$ DBL :6AB8 (04) CURY DBL :6ABE (05) CURX DBL :EA56 (06) EXP DBL :EA59 (07) FRAC DBL :6B43 (08) FRE DBL :EB5C (09) FREQ DBL :6B79 (0A) GETC DBL :6A83 (0B) HEX$ DBL :6B82 (0C) INP DBL :EB8D (0D) INT DBL :6AE2 (0E) LEFT$ DBL :6AC4 (0F) LEN DBL :6BA1 (10) VARPTR DBL :EA5C (11) LOG DBL :EA5F (12) LOGT DBL :6BA7 (13) XMAX DBL :6BAE (14) YMAX DBL :6B0E (15) MID$ DBL :6BC1 (16) PDL DBL :6C16 (17) PEEK DBL :6C1D (18) PI DBL :6AFF (19) RIGHT$ DBL :EC27 (1A) RND DBL :6C9D (1B) SCRN DBL :EC7B (1C) SGN DBL :6A8C (1D) SPC DBL :EA62 (1E) SQR DBL :EA77 (1F) STR$ DBL :6AA2 (20) TAB DBL :6B25 (21) VAL DBL :EA65 (22) SIN DBL :EA68 (23) COS DBL :EA6B (24) TAN DBL :EA6E (25) ASIN DBL :EA71 (26) ACOS DBL :EA74 (27) ATN * * * END